home *** CD-ROM | disk | FTP | other *** search
/ LOGIC Apps / Logic-APPLE_II_APPS.iso / mac / LOGIC Apple II 5.25" Library - ProDOS / PRO108.dsk / DIMMER.bas < prev    next >
BASIC Source File  |  2012-02-16  |  7KB  |  114 lines
  1. 0  REM PRODOS VER 3 FAMILY ROOTS: DIMMER PROGRAM. COPYRIGHT (C) 1986, STEPHEN C. VORENBERG
  2. 55  CLEAR :T$ = "":LI = 768: GOSUB 5000: GOSUB 4000:CC = 0
  3. 60  IF   NOT Q(2)  AND Q(30)  THEN  GOSUB 850: PRINT  CHR$(4)"PR#"Q(43)
  4. 70  GOSUB 6000: GOSUB 12500
  5. 95 FL =  -2
  6. 98 X = 0:FL = FL +1: IF FL >0  THEN 150
  7. 99  IF FL = 0  THEN MQ = MP +1
  8. 100  PRINT  CHR$(4)"CLOSE":X = X +1: IF X >Q(8)  THEN 98
  9. 101  IF ME(X,1) < >FL  THEN 100
  10. 102  ONERR  GOTO 380
  11. 103  PRINT  CHR$(4)"PREFIX,S"ME(X,2)",D"ME(X,3): PRINT  CHR$(4)"PREFIX": INPUT PF$: IF  LEN(ME$(X)) > LEN(PF$)  THEN  IF  LEFT$(ME$(X), LEN(PF$)) = PF$  THEN PF$ = ME$(X): PRINT  CHR$(4)"PREFIX"PF$
  12. 105 ME$(X) = PF$
  13. 107  PRINT  CHR$(4)"OPEN"PF$"FRWHERE,S"ME(X,2)",D"ME(X,3): PRINT  CHR$(4)"READ"PF$"FRWHERE"
  14. 110  INPUT X1: PRINT  CHR$(4):Y = 0
  15. 112 Y = Y +1: IF Y >X1  THEN 100
  16. 113 MP = MP +1:WH(MP,1) = X:WH(MP,2) = ME(X,2):WH(MP,3) = ME(X,3):WH$(MP) = ME$(X): IF X1 <1  THEN WH(MP,0) =  -1: GOTO 100
  17. 115  PRINT  CHR$(4)"READ"PF$"FRWHERE": INPUT X2: INPUT WH$(MP):WH(MP,0) =  -3: IF X2 > -1  THEN WH(MP,0) =  -X2
  18. 120  IF X2 < >0  THEN  PRINT  CHR$(4): GOTO 112
  19. 125  INPUT WH(MP,4): INPUT X4: PRINT  CHR$(4): PRINT  CHR$(4)"OPEN"WH$(MP)"FILE.NUMB": PRINT  CHR$(4)"READ"WH$(MP)"FILE.NUMB": INPUT X5: IF X5 <1  THEN 140
  20. 130  INPUT WH(MP,4):WH(MP,0) = (WH(MP,4) -1) *ND: IF X5 <2  THEN 140
  21. 135 X6 = MP: FOR I = 2 TO X5:MP = MP +1:WH$(MP) = WH$(X6):WH(MP,1) = X:WH(MP,2) = ME(X,2):WH(MP,3) = ME(X,3): INPUT WH(MP,4):WH(MP,0) = (WH(MP,4) -1) *ND: NEXT 
  22. 140  PRINT  CHR$(4)"CLOSE"WH$(MP)"FILE.NUMB": IF X4 < >ND  THEN  PRINT "DATA IN DRIVE "X", DIRECTORY "WH$(MP);: GOSUB 860: PRINT "DOESN'T MATCH THE CONFIGURATION FILE.": FOR I = 1 TO 2000: NEXT :CC = 1
  23. 142  IF X5 <1  THEN MP = MP -1
  24. 145  GOTO 112
  25. 150  POKE 216,0: FOR I = 1 TO MP: IF WH(I,0) =  -3  THEN LD = I:I = MP
  26. 155  NEXT : IF LD <1  THEN  PRINT "NO PROGRAMS FOUND": FOR I = 1 TO 2000: NEXT : GOSUB 310: GOTO 150
  27. 190 LO = 0: ONERR  GOTO 300
  28. 191  IF Q(5)  OR   NOT Q(30)  THEN 195
  29. 194  GOSUB 500: PRINT  SPC( 14)"LOADING NEXT MODULE"
  30. 195  POKE 216,0: IF PF$ < >WH$(LD)  THEN PF$ = WH$(LD): PRINT  CHR$(4)"PREFIX"PF$",S"WH(LD,2)",D"WH(LD,3)
  31. 200  PRINT  CHR$(4)"RUNPROGRAMS"
  32. 300  POKE 216,0:I =  PEEK(222): IF I < >8  THEN  PRINT "ERROR # "I" AT LINE " PEEK(218) +256 * PEEK(219)".  CAN'T CONTINUE.": END 
  33. 305  GOSUB 310: GOTO 190
  34. 310  GOSUB 850: FOR I = 1 TO 8: PRINT : NEXT : INVERSE : PRINT "PLACE PROGRAM DISK IN DRIVE "Q(29): NORMAL : PRINT : PRINT "PRESS ANY KEY WHEN READY";: GOSUB 690:LD = Q(29): RETURN 
  35. 380  PRINT  CHR$(4)"CLOSE":A =  PEEK(222):L =  PEEK(218) +256 * PEEK(219): IF A = 3  AND L = 103  THEN 5080
  36. 381  IF A = 8  OR L = 103  THEN 100
  37. 382  IF A < >5  AND A < >6  THEN 300
  38. 385  PRINT  CHR$(4)"OPEN"PF$"FRWHERE": PRINT  CHR$(4)"WRITE"PF$"FRWHERE": PRINT 1: PRINT 1: PRINT PF$: PRINT  CHR$(4)"CLOSE": PRINT  CHR$(4)"OPEN"PF$"FRWHERE": PRINT  CHR$(4)"READ"PF$"FRWHERE": RESUME 
  39. 500  GOSUB 850: FOR I = 1 TO 7: PRINT : NEXT : INVERSE : PRINT "PLEASE WAIT";: NORMAL : PRINT "....": PRINT 
  40. 510  RETURN 
  41. 690  GET YN$: POKE  -16368,0: NORMAL : PRINT YN$: IF  ASC(YN$) >96  AND  ASC(YN$) <123  THEN YN$ =  CHR$( ASC(YN$) -32)
  42. 691  RETURN 
  43. 850  PRINT : IF Q(43) = 0  OR Q(40)  THEN  HOME : RETURN 
  44. 855  PRINT  CHR$(12): RETURN 
  45. 860  IF Q(22) <79  THEN  PRINT : RETURN 
  46. 861  PRINT " ";: RETURN 
  47. 4000 CZ$ = Q$(22): IF CZ$ = ""  THEN CZ$ =  CHR$(26)
  48. 4010 SP$ =  CHR$(15): IF Q(41) >1  THEN SP$ =  CHR$(20)
  49. 4020  IF Q(68) <1  THEN Q(68) = 1
  50. 4030  IF Q$(39) = ""  THEN Q$(39) = "|"
  51. 4040 ND = Q(16) +Q(14) +Q(38)/Q(36):ND = (Q(68) *(Q(15) -18) -(Q(36) *Q(14) +Q(38)))/ND:ND =  INT(ND/Q(36)) *Q(36)
  52. 4045  FOR I = 41 TO 46: IF Q$(I) = ""  THEN Q$(I) = "/"
  53. 4050  NEXT : IF Q(31) <1  THEN Q(31) = 30
  54. 4090  RETURN 
  55. 5000  ONERR  GOTO 5900
  56. 5010  DIM Q(84),Q$(50)
  57. 5020  PRINT  CHR$(4)"OPEN CONFIGURATION": PRINT  CHR$(4)"READ CONFIGURATION": FOR I = 1 TO 44: INPUT Q(I): NEXT : IF Q(4) <3  OR (Q(4) > = 3  AND Q(39) >3)  THEN 5080
  58. 5030  FOR I = 45 TO 84: INPUT Q(I): NEXT : FOR I = 1 TO 50:Q$(I) = ""
  59. 5040 K = 0: GET A$: IF A$ =  CHR$(127)  THEN A$ =  CHR$(0)
  60. 5042  IF A$ =  CHR$(126)  THEN A$ =  CHR$(13):K = 1
  61. 5045  IF A$ < > CHR$(13)  OR K = 1  THEN Q$(I) = Q$(I) +A$: GOTO 5040
  62. 5050  NEXT : INPUT A$: PRINT  CHR$(4)"CLOSE": POKE 216,0
  63. 5060  RETURN 
  64. 5080  ONERR  GOTO 5090
  65. 5085  PRINT  CHR$(4)"RUNMANAGER"
  66. 5090  POKE 216,0:A =  PEEK(222):Q(29) = 1: GOSUB 5095: GOTO 5080
  67. 5095  GOSUB 850: FOR I = 1 TO 8: PRINT : NEXT : INVERSE : PRINT "PLACE THE DISK CONTAINING 'MANAGER'";: GOSUB 860: PRINT "IN THE DRIVE LAST USED (BOOT DRIVE?).": NORMAL : PRINT : PRINT "PRESS ANY KEY WHEN READY";: GOSUB 690: RETURN 
  68. 5900 A =  PEEK(222): IF A < >5  AND A < >6  AND A < >8  THEN 5920
  69. 5910  PRINT "THERE IS NO CONFIGURATION FILE ON THE";: GOSUB 860: PRINT "PROGRAM DISK.  PLEASE RUN THE 'MANAGER'": PRINT "PROGRAM.": END 
  70. 5920  PRINT "ERROR # "A". PLEASE SEE DOS MANUAL.": END 
  71. 6000 I = Q(18): IF I <25  THEN I = 25
  72. 6002  DIM C$(I),G$(I),F$(3 *I),EX$(Q(17)),MI$(4,Q(19)),RC$(22):A = Q(24): IF A <Q(36) *Q(37)  THEN A = Q(36) *Q(37)
  73. 6010  DIM SV(A),OP(30),OP$(30),TY(30),G(13):G(10) = A
  74. 6015 I = Q(18): IF I <19  THEN I = 19
  75. 6016  IF I <Q(20)  THEN I = Q(20)
  76. 6017 J = Q(20): IF J <11  THEN J = 11
  77. 6018  IF I <Q(75)  THEN I = Q(75)
  78. 6019  IF J <Q(75) -1  THEN J = Q(75) -1
  79. 6020  DIM OD(I),T(J +1),OE(I)
  80. 6022 I = 31: IF Q(18) >I  THEN I = Q(18)
  81. 6025  DIM EM$(I)
  82. 6030  DIM MT$(12): FOR I = 0 TO 12: READ MT$(I): NEXT 
  83. 6040  DIM CH$(4),H$(9),H1$(5),VR$(10),WR$(4)
  84. 6041 I = Q(18): IF I <31  THEN I = 31
  85. 6042 J = Q(20): IF J <Q(42)  THEN J = Q(42)
  86. 6043  IF J <Q(19)  THEN J = Q(19)
  87. 6044  IF (J -2) *I <Q(75)  THEN J = Q(75)/I +2
  88. 6045  IF J <Q(17)  THEN J = Q(17)
  89. 6046  DIM S$(I,J): GOSUB 7000
  90. 6050  DIM NA$(Q(36) *Q(37)),PA(Q(37) -1),SC(Q(37) -1),CT(Q(37) -1),PT(Q(37) -1),ME(Q(8),3),ME$(Q(8)),WH(Q(31),4),WH$(Q(31))
  91. 6060  GOSUB 8400: GOSUB 8000: GOSUB 8100
  92. 6100  DIM DF(Q(44) +11),FP(22)
  93. 6110  IF Q(44) = 0  THEN  RETURN 
  94. 6120  FOR I = 1 TO Q(44):FP(I +11) =  VAL( RIGHT$(Q$(I +11),1)) +11: IF FP(I +11) = 11  THEN FP(I +11) = 0
  95. 6125 A =  LEN(Q$(I +11)):DF(I +11) =  VAL( MID$ (Q$(I +11),A -1,1)): IF A >2  THEN Q$(I +11) =  LEFT$(Q$(I +11),A -2): GOTO 6130
  96. 6127 Q$(I +11) = ""
  97. 6130  NEXT : RETURN 
  98. 7000 G(9) = 12: RETURN 
  99. 8000 KY =  LEN(Q$(30)) -1: IF KY <0  THEN  RETURN 
  100. 8010  DIM KY(KY),KY$(KY)
  101. 8015 LB = 4: IF KY <LB  THEN LB = KY
  102. 8020  FOR I = 0 TO KY:KY(I) =  ASC( MID$ (Q$(30),I +1,1)) -64: IF I < = LB  THEN KY$(I) = Q$(I +31)
  103. 8030  NEXT : RETURN 
  104. 8100 RN$ = "RN": RETURN 
  105. 8400 MP = 0:MQ = 0: FOR I = 1 TO Q(8):ME(I,0) = Q(75 +I):ME$(I) = Q$(40 +I): FOR J = 2 TO 3:ME(I,J) = Q(47 +J +(I -1) *2): NEXT : NEXT :A$ =  STR$(Q(67))
  106. 8405  IF  LEN(A$) <Q(8)  THEN A$ = "0" +A$: GOTO 8405
  107. 8410  IF  LEN(A$) >Q(8)  THEN A$ =  RIGHT$(A$,Q(8))
  108. 8415  FOR I = 1 TO Q(8):ME(I,1) =  VAL( MID$ (A$,Q(8) -I +1,1)) -1: NEXT 
  109. 8420  RETURN 
  110. 10000  DATA "???","Jan","Feb","Mar","Apr","May","Jun","Jul","Aug","Sep","Oct","Nov","Dec"
  111. 12500 DY$ = "":A =  PEEK(49040):N =  PEEK(49041): IF A +N = 0  THEN DY$ = Q$(3): RETURN 
  112. 12510 K =  INT(N/2):I = A - INT(A/32) *32:J = (N -K *2) *8 + INT(A/32): IF J <1  OR J >12  THEN J = 0
  113. 12520 DY$ =  STR$(I) +" " +MT$(J) +" " + STR$(K): RETURN 
  114. 20000  RUN